Datos

library(tidyquant)
Loading required package: lubridate

Attaching package: ‘lubridate’

The following objects are masked from ‘package:base’:

    date, intersect, setdiff, union

Loading required package: PerformanceAnalytics
Loading required package: xts
Loading required package: zoo

Attaching package: ‘zoo’

The following objects are masked from ‘package:base’:

    as.Date, as.Date.numeric


Attaching package: ‘PerformanceAnalytics’

The following object is masked from ‘package:graphics’:

    legend

Loading required package: quantmod
Loading required package: TTR
Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 
library(tidyverse)
── Attaching core tidyverse packages ──────────────────────────────────────────────────────────────── tidyverse 2.0.0 ──
✔ dplyr   1.1.4     ✔ readr   2.1.5
✔ forcats 1.0.0     ✔ stringr 1.5.1
✔ ggplot2 3.4.4     ✔ tibble  3.2.1
✔ purrr   1.0.2     ✔ tidyr   1.3.0── Conflicts ────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::first()  masks xts::first()
✖ dplyr::lag()    masks stats::lag()
✖ dplyr::last()   masks xts::last()
ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors
library(tsibble)

Attaching package: ‘tsibble’

The following object is masked from ‘package:zoo’:

    index

The following object is masked from ‘package:lubridate’:

    interval

The following objects are masked from ‘package:base’:

    intersect, setdiff, union
library(fable)
Loading required package: fabletools

Attaching package: ‘fable’

The following object is masked from ‘package:tidyquant’:

    VAR
library(feasts)
index = tq_index("SP500") %>% select(symbol, weight)
Getting holdings for SP500
index = index %>% filter(symbol != "-")
index
sum(index$weight)
[1] 0.9961429
data = tq_get(index$symbol, get = "stock.prices", from = "2022-01-01", to = "2024-03-29") %>% select(symbol, date, adjusted)
Warning: There were 2 warnings in `dplyr::mutate()`.
The first warning was:
ℹ In argument: `data.. = purrr::map(...)`.
Caused by warning:
! x = 'GEV', get = 'stock.prices': Error in getSymbols.yahoo(Symbols = "GEV", env = <environment>, verbose = FALSE, : Unable to import “GEV”.
HTTP error 400.
 Removing GEV.
ℹ Run ]8;;ide:run:dplyr::last_dplyr_warnings()dplyr::last_dplyr_warnings()]8;; to see the 1 remaining
  warning.
symbols_from_data = unique(data$symbol)
data = pivot_wider(data, id_cols = date, names_from = symbol, values_from = adjusted)
data = mutate(data, t = row_number())
data = pivot_longer(data, all_of(symbols_from_data), names_to = "symbol", values_to = "adjusted")
data = as_tsibble(data, index = t, key = symbol)

Split de datos

train = data %>% filter_index(. ~ (562-30))
test = data %>% filter_index((562-30+1) ~ .)

Modelos

ETS y ARIMA

sp500_arima_ets = train %>% model(arima = ARIMA(adjusted),
                                  ets = ETS(adjusted))
Warning: NaNs producedWarning: NaNs producedWarning: NaNs producedWarning: NaNs producedWarning: NaNs producedWarning: NaNs producedWarning: NaNs producedWarning: NaNs producedWarning: NaNs producedWarning: NaNs producedWarning: NaNs produced
sp500_arima_ets
ticker = "ABNB"
sp500_arima_ets %>% filter(symbol == ticker) %>% augment() |>
  ggplot(aes(x = t)) +
  geom_line(aes(y = adjusted, colour = "reales")) +
  geom_line(aes(y = .fitted, colour = "ajustados")) +
  labs(y = NULL,
    title = ticker
  ) +
  guides(colour = guide_legend(title = NULL))
fit_accuracy <- sp500_arima_ets %>% forecast(h = 30) %>% accuracy(test, measures = lst(MAPE)) %>% 
  pivot_wider(names_from = .model, values_from = MAPE) %>% 
  select(-.type)
fit_accuracy
best_fit <- sp500_arima_ets %>% 
  transmute(
    symbol, # Need to keep key variables for a valid mable
    best_fit = if_else(fit_accuracy$ets < fit_accuracy$arima, ets, arima)
  )
best_fit
LS0tCnRpdGxlOiAnUyZQIDUwMCcKc3VidGl0bGU6ICdDbGFzZSBzZXJpZXMgZGUgdGllbXBvLCBwcmltYXZlcmEgMjAyNCcKYXV0aG9yOiAnRGFuaWVsIE51w7FvLCBkYW5pZWwubnVub0BpdGVzby5teCcKZGF0ZTogIkFicmlsIDEwLCAyMDI0IgpvdXRwdXQ6CiAgaHRtbF9ub3RlYm9vazoKICAgIHRvYzogeWVzCiAgICB0b2NfZmxvYXQ6IHllcwogICAgdGhlbWU6IGNvc21vCiAgICBoaWdobGlnaHQ6IHRhbmdvCiAgZ2l0aHViX2RvY3VtZW50OgogICAgdG9jOiB5ZXMKICAgIGRldjoganBlZwogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IHllcwogICAgZGZfcHJpbnQ6IHBhZ2VkCi0tLQoKYGBge3Igc2V0dXAsIGVjaG8gPSBGQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG89IFRSVUUsCiAgICAgICAgICAgICAgICAgICAgICBmaWcuaGVpZ2h0ID0gNiwgZmlnLndpZHRoID0gNykKYGBgCgpgYGB7PWh0bWx9CjxzdHlsZT4KLmZvcmNlQnJlYWsgeyAtd2Via2l0LWNvbHVtbi1icmVhay1hZnRlcjogYWx3YXlzOyBicmVhay1hZnRlcjogY29sdW1uOyB9Cjwvc3R5bGU+CmBgYAo8Y2VudGVyPiFbXShodHRwczovL3VwbG9hZC53aWtpbWVkaWEub3JnL3dpa2lwZWRpYS9jb21tb25zL2QvZGIvTG9nb19JVEVTT19ub3JtYWwuanBnKXt3aWR0aD0iMjAlIn08L2NlbnRlcj4KCiMgRGF0b3MKCmBgYHtyfQpsaWJyYXJ5KHRpZHlxdWFudCkKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkodHNpYmJsZSkKbGlicmFyeShmYWJsZSkKbGlicmFyeShmZWFzdHMpCmBgYAoKYGBge3J9CmluZGV4ID0gdHFfaW5kZXgoIlNQNTAwIikgJT4lIHNlbGVjdChzeW1ib2wsIHdlaWdodCkKaW5kZXggPSBpbmRleCAlPiUgZmlsdGVyKHN5bWJvbCAhPSAiLSIpCmluZGV4CnN1bShpbmRleCR3ZWlnaHQpCgpkYXRhID0gdHFfZ2V0KGluZGV4JHN5bWJvbCwgZ2V0ID0gInN0b2NrLnByaWNlcyIsIGZyb20gPSAiMjAyMy0wMS0wMSIsIHRvID0gIjIwMjQtMDMtMjkiKSAlPiUgc2VsZWN0KHN5bWJvbCwgZGF0ZSwgYWRqdXN0ZWQpCgpgYGAKYGBge3J9CnN5bWJvbHNfZnJvbV9kYXRhID0gdW5pcXVlKGRhdGEkc3ltYm9sKQpkYXRhID0gcGl2b3Rfd2lkZXIoZGF0YSwgaWRfY29scyA9IGRhdGUsIG5hbWVzX2Zyb20gPSBzeW1ib2wsIHZhbHVlc19mcm9tID0gYWRqdXN0ZWQpCmRhdGEgPSBtdXRhdGUoZGF0YSwgdCA9IHJvd19udW1iZXIoKSkKZGF0YSA9IHBpdm90X2xvbmdlcihkYXRhLCBhbGxfb2Yoc3ltYm9sc19mcm9tX2RhdGEpLCBuYW1lc190byA9ICJzeW1ib2wiLCB2YWx1ZXNfdG8gPSAiYWRqdXN0ZWQiKQpkYXRhID0gYXNfdHNpYmJsZShkYXRhLCBpbmRleCA9IHQsIGtleSA9IHN5bWJvbCkKZGF0YSA9IGRhdGEgJT4lIGZpbHRlcighaXMubmEoYWRqdXN0ZWQpKQpgYGAKCiMjIFNwbGl0IGRlIGRhdG9zCgpgYGB7cn0KdHJhaW4gPSBkYXRhICU+JSBmaWx0ZXJfaW5kZXgoLiB+ICg1NjItMzApKQp0ZXN0ID0gZGF0YSAlPiUgZmlsdGVyX2luZGV4KCg1NjItMzArMSkgfiAuKQpgYGAKCiMgTW9kZWxvcwoKIyMgRVRTIHkgQVJJTUEKCmBgYHtyfQpzcDUwMF9hcmltYV9ldHMgPSB0cmFpbiAlPiUgbW9kZWwoYXJpbWEgPSBBUklNQShsb2coYWRqdXN0ZWQpKSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGV0cyA9IEVUUyhsb2coYWRqdXN0ZWQpKSkKYGBgCgpgYGB7cn0Kc3A1MDBfYXJpbWFfZXRzCmBgYAoKYGBge3J9CnRpY2tlciA9ICJBQk5CIgpzcDUwMF9hcmltYV9ldHMgJT4lIGZpbHRlcihzeW1ib2wgPT0gdGlja2VyKSAlPiUgYXVnbWVudCgpIHw+CiAgZ2dwbG90KGFlcyh4ID0gdCkpICsKICBnZW9tX2xpbmUoYWVzKHkgPSBhZGp1c3RlZCwgY29sb3VyID0gInJlYWxlcyIpKSArCiAgZ2VvbV9saW5lKGFlcyh5ID0gLmZpdHRlZCwgY29sb3VyID0gImFqdXN0YWRvcyIpKSArCiAgbGFicyh5ID0gTlVMTCwKICAgIHRpdGxlID0gdGlja2VyCiAgKSArCiAgZ3VpZGVzKGNvbG91ciA9IGd1aWRlX2xlZ2VuZCh0aXRsZSA9IE5VTEwpKQpgYGAKCgpgYGB7cn0KZml0X2FjY3VyYWN5IDwtIHNwNTAwX2FyaW1hX2V0cyAlPiUgZm9yZWNhc3QoaCA9IDMwKSAlPiUgYWNjdXJhY3kodGVzdCwgbWVhc3VyZXMgPSBsc3QoTUFQRSkpICU+JSAKICBwaXZvdF93aWRlcihuYW1lc19mcm9tID0gLm1vZGVsLCB2YWx1ZXNfZnJvbSA9IE1BUEUpICU+JSAKICBzZWxlY3QoLS50eXBlKQpmaXRfYWNjdXJhY3kKYGBgCgpgYGB7cn0KYmVzdF9maXQgPC0gc3A1MDBfYXJpbWFfZXRzICU+JSAKICB0cmFuc211dGUoCiAgICBzeW1ib2wsCiAgICBiZXN0X2ZpdCA9IGlmX2Vsc2UoZml0X2FjY3VyYWN5JGV0cyA8IGZpdF9hY2N1cmFjeSRhcmltYSwgZXRzLCBhcmltYSkKICApCmJlc3RfZml0CmBgYAoK